home *** CD-ROM | disk | FTP | other *** search
/ IRIS Performer 2.2 Friends Demo / SGI IRIS Performer 2.2 Friends Demo.iso / friends / openworlds / tix / Balloon.tcl.bak < prev    next >
Text File  |  1997-11-22  |  15KB  |  681 lines
  1. # tixBalloon -
  2. #
  3. #    The help widget. It provides both "balloon" type of help message
  4. # and "status bar" type of help message. You can use this widget to indicate
  5. # the function of the widgets inside your application.
  6. #
  7. #
  8. tixWidgetClass tixBalloon {
  9.     -classname TixBalloon
  10.     -superclass tixShell
  11.     -method {
  12.     bind post unbind
  13.     }
  14.     -flag {
  15.     -installcolormap -initwait -state -statusbar
  16.     }
  17.     -configspec {
  18.     {-installcolormap installColormap InstallColormap false}
  19.     {-initwait initWait InitWait 200}
  20.     {-state state State both}
  21.     {-statusbar statusBar StatusBar {}}
  22.  
  23.      {-cursor cursor Cursur left_ptr}
  24.     }
  25.     -default {
  26.     {*background             #ffff60}
  27.     {*foreground             black}
  28.     {*borderWidth             0}
  29.     {.borderWidth             1}
  30.     {.background             black}
  31.     }
  32. }
  33.  
  34. # Class Record
  35. #
  36. set tixBalloon(bals) {}
  37.  
  38. bind all <Motion>         "+tixBalloon::XXMotion %X %Y"
  39. bind all <1>              "+tixBalloon::XXButton-1 %X %Y"
  40. bind all <ButtonRelease-1>  "+tixBalloon::XXButton-1 %X %Y"
  41.  
  42. proc tixBalloon:XXMotion {rootX rootY} {
  43.     global tixBalloon
  44.  
  45.     foreach w $tixBalloon(bals) {
  46.     tixBalloon::XXMotion $w $rootX $rootY
  47.     }
  48. }
  49.  
  50. proc tixBalloon::XXMotion {w rootX rootY} {
  51.     upvar #0 $w data
  52.  
  53.  
  54.  
  55. }
  56.  
  57. set btn_fields  {
  58. %% %# %a %b %c %d %f %h %k %m %o %p %s %t %w %x %y %A %B %E %K %N %R %S %T %W %X %Y
  59. }
  60.  
  61. proc tixBalloon::InitWidgetRec {w} {
  62.     upvar #0 $w data
  63.     global tixBalloon
  64.  
  65.     tixChainMethod $w InitWidgetRec
  66.  
  67.     set data(popped)    0
  68.     set data(fakeLeave) 0
  69.     set data(statusSet) 0
  70.     set data(serial)    0
  71.     set data(fakeEnter) 0
  72.     set data(curWidget) {}
  73.  
  74.     lappend tixBalloon(bals) $w
  75. }
  76.  
  77. proc tixBalloon::ConstructWidget {w} {
  78.     upvar #0 $w data
  79.  
  80.     tixChainMethod $w ConstructWidget
  81.  
  82.     wm overrideredirect $w 1
  83.     wm withdraw $w
  84.  
  85.     # Frame 1 : arrow
  86.     frame $w.f1 -bd 0
  87.     set data(w:label) [label $w.f1.lab -bd 0 -relief flat \
  88.                -bitmap [tix getbitmap balArrow]]
  89.     pack $data(w:label) -side left -padx 1 -pady 1
  90.     
  91.     # Frame 2 : Message
  92.     frame $w.f2 -bd 0
  93.     set data(w:message) [message $w.f2.message -padx 0 -pady 0 -bd 0]
  94.     pack $data(w:message) -side left -expand yes -fill both -padx 10 -pady 1
  95.  
  96.     # Pack all
  97.     pack $w.f1 -fill both
  98.     pack $w.f2 -fill both    
  99. }
  100.  
  101.  
  102. #----------------------------------------------------------------------
  103. # Config:
  104. #----------------------------------------------------------------------
  105.  
  106. proc tixBalloon::config-state {w value} {
  107.     upvar #0 $w data
  108.  
  109.     case $value {
  110.     {none balloon status both} {}
  111.     default {
  112.        error "invalid value $value, must be none, balloon, status, or both"
  113.     }
  114.     }
  115. }
  116.  
  117. #----------------------------------------------------------------------
  118. # PrivateMethods:
  119. #----------------------------------------------------------------------
  120.  
  121. proc tixBalloon::ClientDestroy {w client} {
  122.     upvar #0 $w data
  123.  
  124.     if {$data(curWidget) == $client} {
  125.     tixBalloon::Popdown $w
  126.     }
  127.  
  128.     # Maybe thses have already been unset by the Destroy method
  129.     #
  130.     catch {unset data(m:$client)}
  131.     catch {unset data(s:$client)}
  132. }
  133.  
  134. # Handle the mouse pointer entering the client widget
  135. #
  136. proc tixBalloon::Enter {w client} {
  137.     upvar #0 $w data
  138.  
  139.     if {$data(fakeEnter) > 0} {
  140.     # The mouse pointer just left either the balloon window or the
  141.     # client window: do nothing; otherwise the balloon will flash
  142.     #
  143.     set data(fakeEnter) 0
  144.     return
  145.     }
  146.     if {$data(-state) != "none"} {
  147.         set data(popped)    0
  148.         set data(statusSet) 0
  149.     set data(curWidget) $client
  150.     incr data(serial)
  151.         after $data(-initwait) tixBalloon::Activate $w $data(serial)
  152.     }
  153. }
  154.  
  155. proc tixBalloon::post {w client} {
  156.     upvar #0 $w data
  157.  
  158.     if {![info exists data(m:$client)]} {
  159.     return
  160.     }
  161.     tixBalloon::Enter $w $client
  162.     incr data(fakeEnter)
  163. }
  164.  
  165. proc tixBalloon::Within {wid rootX rootY} {
  166.     set rx1 [winfo rootx $wid]
  167.     set ry1 [winfo rooty $wid]
  168.     set rw  [winfo width  $wid]
  169.     set rh  [winfo height $wid]
  170.     set rx2 [expr $rx1+$rw]
  171.     set ry2 [expr $ry1+$rh]
  172.  
  173.     if {$rootX >= $rx1 && $rootX < $rx2 && $rootY >= $ry1 && $rootY < $ry2} {
  174.     return 1
  175.     } else {
  176.     return 0
  177.     }
  178. }
  179.  
  180. proc tixBalloon::Leave [concat w $btn_fields] {
  181.     upvar #0 $w data
  182.  
  183.     return
  184.     set rootX [set %X]
  185.     set rootY [set %Y]
  186.  
  187.     if {$data(curWidget) == ""} {
  188.     return
  189.     }
  190.     if {$data(fakeLeave) == 1} {
  191.     set data(fakeLeave) 0
  192.     return
  193.     }
  194.  
  195.     set cw [winfo containing $rootX $rootY]
  196.     set mask [tixBalloon::GetMask $w $data(curWidget)]
  197.  
  198.     if [tixBalloon::Within $w $rootX $rootY] {
  199.     # It is safe to do this because we know the balloon is always on top
  200.     #
  201.     set data(fakeEnter) 1
  202.     return
  203.     }
  204.     if [tixBalloon::Within $data(curWidget) $rootX $rootY] {
  205.     return
  206.     }
  207.     if {$cw == $mask} {
  208.     set data(fakeEnter) 1
  209.     return
  210.     }
  211.  
  212.     puts LLLLLL
  213.  
  214.     if {$data(popped) == 1 || $data(statusSet) == 1} {
  215.     set data(fakeEnter) 0
  216.     tixBalloon::Popdown $w
  217.     } else {
  218.     # have to make sure that previous popup's are cancelled
  219.     # just make sure previous
  220.     #
  221.     incr data(serial)
  222.     }
  223.     
  224.     tixDeleteBindTag $data(curWidget) InterceptLeave
  225.  
  226.     set args {}
  227.     global btn_fields
  228.     foreach f $btn_fields {
  229.     lappend args [set $f]
  230.     }
  231.     eval tixBalloon::GenerateEvent $w $data(curWidget) <Leave> $args
  232. }
  233.  
  234. proc tixBalloon::Activate {w serial} {
  235.  
  236.     if {![winfo exists $w]} {
  237.     return
  238.     }
  239.     upvar #0 $w data
  240.  
  241.     if [info exists data(grabbed)] {
  242.     return
  243.     }
  244.  
  245.  
  246.     if {![winfo exists $data(curWidget)]} {
  247.     return
  248.     }
  249.     
  250.     if {$serial != $data(serial)} {
  251.     # a new balloon will be activated by the latest call
  252.     #
  253.     return    
  254.     }
  255.  
  256.     set mask [tixBalloon::GetMask $w $data(curWidget)]
  257.  
  258.  
  259.     if {![tixBalloon::IsInClient $w $data(curWidget) $data(curWidget)]} {
  260.     return
  261.     }
  262.  
  263.     tixBalloon::InterceptLeave $w $data(curWidget)
  264.  
  265.     # Put the inputonly window over the client
  266.     #
  267.     set tp [winfo toplevel $data(curWidget)]
  268.     set x [expr [winfo rootx $data(curWidget)]-[winfo rootx $tp]]
  269.     set y [expr [winfo rooty $data(curWidget)]-[winfo rooty $tp]]
  270.     set W [winfo width  $data(curWidget)]
  271.     set H [winfo height $data(curWidget)]
  272.  
  273.     tixMoveResizeWindow $mask $x $y $W $H
  274.     tixMapWindow $mask
  275.     raise $mask
  276.     update
  277.  
  278.     if {$data(-state) == "both" || $data(-state) == "balloon"} {
  279.     tixBalloon::Popup $w
  280.     }
  281.     if {$data(-state) == "both" || $data(-state) == "status"} {
  282.     tixBalloon::SetStatus $w
  283.     }
  284. }
  285.  
  286. proc tixBalloon::Popup {w} {
  287.     upvar #0 $w data
  288.  
  289.     if [tixGetBoolean -nocomplain $data(-installcolormap)] {
  290.     wm colormapwindows [winfo toplevel $data(curWidget)] $w
  291.     }
  292.  
  293.     # trick: the following lines allow the balloon window to
  294.     # acquire a stable width and height when it is finally
  295.     # put on the visible screen
  296.     #
  297.     set client $data(curWidget)
  298.     $data(w:message) config -text $data(m:$client)
  299.     wm geometry $w +10000+10000
  300.     wm deiconify $w
  301.     raise $w
  302.     update
  303.  
  304.     # Put it on the visible screen
  305.     #
  306.     set x [expr [winfo rootx $client]+[winfo width  $client]/2]
  307.     set y [expr int([winfo rooty $client]+[winfo height $client]/1.3)]
  308.  
  309.     wm geometry $w +$x+$y
  310.  
  311.     set data(popped) 1
  312.  
  313.     after 100 "tixBalloon::Verify $w $data(curWidget)"
  314. }
  315.  
  316. bind InterceptLeave <Leave> "tixBalloon:InterceptLeaveDone %W; break"
  317.  
  318. proc tixBalloon::InterceptLeave {w client} {
  319.     tixAddBindTag $client InterceptLeave
  320. }
  321.  
  322. proc tixBalloon:InterceptLeaveDone {client} {
  323.     tixDeleteBindTag $client tixAddBindTag
  324. }
  325.  
  326.  
  327. # tixBalloon::Verify
  328. #    Sometimes we "lose events" when the user moves the mouse pointer
  329. #    rapidly. This routine continuously check whether the mouse
  330. #    pointer is still in the balloon region. If not, it pops down the
  331. #    balloon.
  332. #
  333. proc tixBalloon::Verify {w client} {
  334.     upvar #0 $w data
  335.  
  336.     if {![winfo exists $w]} {
  337.     return
  338.     }
  339.  
  340.     if {!$data(popped)} {
  341.     return
  342.     }
  343.     if {$data(curWidget) != $client} {
  344.     return
  345.     }
  346.  
  347.     set mask [tixBalloon::GetMask $w $client]
  348.  
  349.     if {![tixBalloon::IsInClient $w $client $mask]} {
  350.     tixBalloon::Popdown $w
  351.     } else {
  352.     after 100 tixBalloon::Verify $w $client
  353.     }
  354. }
  355.  
  356. proc tixBalloon::IsInClient {w client mask} {
  357.     upvar #0 $w data
  358.  
  359.     set rootX [winfo pointerx $client]
  360.     set rootY [winfo pointery $client]
  361.  
  362.     if {$rootX == -1 || $rootY == -1} {
  363.     # mouse pointercursor moved to another screen
  364.     return 0
  365.     }
  366.  
  367.     set cw [winfo containing $rootX $rootY]
  368.  
  369.     if {[tixBalloon::Within $w $rootX $rootY]} {
  370.     # return 1 if mouse pointer position OK
  371.     # (still in either client or balloon)
  372.     return 1
  373.     }
  374.     if {$client == $mask} {
  375.     if {[string match $mask* $cw]} {
  376.         return 1
  377.     }
  378.     } else {
  379.     if {$cw == $mask} {
  380.         return 1
  381.     }
  382.     }
  383.  
  384.     return 0
  385. }
  386.  
  387. proc tixBalloon::Popdown {w} {
  388.     upvar #0 $w data
  389.  
  390.     # Close the balloon
  391.     #
  392.     wm withdraw $w
  393.  
  394.     # Clear the status bar
  395.     #
  396.     if {$data(statusSet) == 1} {
  397.     tixBalloon::ClearStatus $w
  398.     set $data(statusSet) 0
  399.     }
  400.  
  401.     # Withdraw the mask window
  402.     #
  403.     tixUnmapWindow [tixBalloon::GetMask $w $data(curWidget)]
  404.  
  405.     set data(popped) 0
  406. }
  407.  
  408. proc tixBalloon::SetStatus {w} {
  409.     upvar #0 $w data
  410.  
  411.     if {![winfo exists $data(-statusbar)]} {
  412.     return
  413.     }
  414.  
  415.     if {$data(-statusbar) != {}} {
  416.     set vv [$data(-statusbar) cget -textvariable]
  417.     if {$vv == ""} {
  418.         $data(-statusbar) config -text $data(s:$data(curWidget))
  419.     } else {
  420.         uplevel #0 set $vv [list $data(s:$data(curWidget))]
  421.     }
  422.     }
  423.     set data(statusSet) 1
  424. }
  425.  
  426. proc tixBalloon::ClearStatus {w} {
  427.     upvar #0 $w data
  428.  
  429.     if {![winfo exists $data(-statusbar)]} {
  430.     return
  431.     }
  432.  
  433.     # Clear the StatusBar widget
  434.     #
  435.     if {$data(-statusbar) != {}} {
  436.     set vv [$data(-statusbar) cget -textvariable]
  437.     if {$vv == ""} {
  438.         $data(-statusbar) config -text ""
  439.     } else {
  440.         uplevel #0 set $vv [list ""]
  441.     }
  442.     }
  443. }
  444.  
  445. proc tixBalloon::BindOneWidget {w client subwidget} {
  446.     upvar #0 $w data
  447.  
  448.     if {![winfo exists $subwidget]} {
  449.     return
  450.     }
  451.  
  452.     set class [winfo class $subwidget]
  453.  
  454.     bind TixBalloon$client <Any-Enter>  "tixBalloon::Enter $w $client"
  455.     bind TixBalloon$client <Destroy>    "tixBalloon::ClientDestroy $w $client"
  456.  
  457.     tixAppendBindTag $client TixBalloon$client
  458. }
  459. #----------------------------------------------------------------------
  460. # Mask window handlng
  461. #----------------------------------------------------------------------
  462.  
  463. # We need a "mask" window to put all over the client widget so that we can
  464. # find out when the user presses the mouse buttons
  465. #
  466. # This is the most complicated code in all of Tix. If you don't understand 
  467. # is going on, don't touch it.
  468. #
  469.  
  470.  
  471. bind TixBalloon <Leave> [concat tixBalloon::Leave %W $btn_fields]
  472. bind TixBalloon <Visibility> "raise %W"
  473.  
  474.  
  475. # Since the mask window overlays the client widget, it gets all the mouse 
  476. # events of the client widget. We need to capture these events and resend
  477. # them to the client widget.
  478. # 
  479. proc tixBalloon::InterceptMouseEvents {w mask client} {
  480.     global btn_fields
  481.  
  482.     if {![winfo exists $client]} {
  483.     return
  484.     }
  485.  
  486.     foreach tag [bindtags $client] {
  487.     foreach event [bind $tag] {
  488.         if [regexp {([1-3]>$)} $event] {
  489.         # This is a button event
  490.  
  491.         bind $mask $event \
  492.             [concat tixBalloon::GenerateEvent \
  493.             $w $client $event $btn_fields]
  494.         }
  495.     }
  496.     }
  497.  
  498.     # We want this for all widgets:
  499.     #   pressing any mouse button and the
  500.     #   balloon goes away
  501.     bind $mask <1> \
  502.     [concat tixBalloon::GenerateEvent $w $client <1> $btn_fields]
  503.     bind $mask <2> \
  504.     [concat tixBalloon::GenerateEvent $w $client <2> $btn_fields]
  505.     bind $mask <3> \
  506.     [concat tixBalloon::GenerateEvent $w $client <3> $btn_fields]
  507. }
  508.  
  509. proc tixBalloon::ReleaseGrab {w client} {
  510.     upvar #0 $w data
  511.     global tkPriv
  512.  
  513.     catch {
  514.     if {$data(grabbed) != {}} {
  515.         grab release $client
  516.     }
  517.     unset data(grabbed)
  518.     }
  519. }
  520.  
  521. proc tixBalloon::SetGrab {w client event} {
  522.     upvar #0 $w data
  523.  
  524.     if {[grab current $w] != {}} {
  525.     return
  526.     }
  527.  
  528.     if [string match "*1*" $event] {
  529.     set btn 1
  530.     } elseif [string match "*2*" $event] {
  531.     set btn 2
  532.     } elseif [string match "*3*" $event] {
  533.     set btn 3
  534.     }
  535.  
  536.     if {[winfo class $client] == "Menubutton"} {
  537.     # No need to grab, it will take care of itself
  538.     #
  539.     set data(grabbed) {}
  540.     } else {
  541.     puts grabbed
  542.     set data(grabbed) $client
  543.     grab -global $client
  544.     }
  545.     bind $client <ButtonRelease-$btn> \
  546.     "tixBalloon::ReleaseGrab $w $client"
  547. }
  548.  
  549. # When this function is called, we have intercepted a mouse event
  550. # for the client widget. Let's send it to the client. But before
  551. # that we have to substitute all the % stuff in the commands.
  552. #
  553. #
  554. proc tixBalloon::GenerateEvent [concat w defClient event $btn_fields] {
  555.     upvar #0 $w data
  556.     global btn_fields
  557.  
  558.     tixBalloon::Popdown $w
  559.     tixDeleteBindTag $data(curWidget) InterceptLeave
  560.  
  561.     set client [winfo containing [set %X] [set %Y]]
  562.     set leave 0
  563.     if {$client == {}} {
  564.     set client $defClient
  565.     set leave 1
  566.     }
  567.     if {$event == "<Leave>"} {
  568.     set client $defClient
  569.     }
  570.  
  571.     if {$event != "<Leave>"} {
  572.     if {$leave} {
  573.         global btn_fields
  574.         set args {}
  575.         foreach f $btn_fields {
  576.         lappend args [set $f]
  577.         }
  578.         eval tixBalloon::GenerateEvent $w $data(curWidget) <Leave> $args
  579.     } else {
  580.         tixBalloon::SetGrab $w $data(curWidget) $event
  581.     }
  582.     }
  583.  
  584.     set %W $client
  585.  
  586.     foreach tag [bindtags $client] {
  587.     set command [bind $tag $event]
  588.  
  589.     if {$command  == {}} {
  590.         continue
  591.     }
  592.  
  593.     foreach f $btn_fields {
  594.         regsub -all $f $command [set $f] command
  595.     }
  596.  
  597.     uplevel #0 eval [list $command]
  598.     puts $command
  599.     }
  600.  
  601.     if {$event != "<Leave>"} {
  602.     set data(fakeEnter) 1
  603.     set data(fakeLeave) 1
  604.     }
  605. }
  606.  
  607. proc tixBalloon::GetMask {w client} {
  608.     global btn_fields
  609.     if {![winfo exists $client]} {
  610.     ## Something insane has happened!
  611.     set tp .
  612.     } else {
  613.     set tp [winfo toplevel $client]
  614.     }
  615.  
  616.     if {$tp == "."} {
  617.     set tp ""
  618.     }
  619.  
  620.     set mask $tp.tixInt:bal
  621.  
  622.     if {![winfo exists $mask]} {
  623.     tixInputOnly $mask
  624.     bind $mask <Leave>  [concat tixBalloon::Leave $w $btn_fields]
  625.     }
  626.     tixBalloon::InterceptMouseEvents $w $mask $client
  627.  
  628.     return $mask
  629. }
  630.  
  631. #----------------------------------------------------------------------
  632. # PublicMethods:
  633. #----------------------------------------------------------------------
  634.  
  635. # %% if balloon is already popped-up for this client, change mesage
  636. #
  637. proc tixBalloon::bind {w client args} {
  638.     upvar #0 $w data
  639.  
  640.     if [info exists data(m:$client)] {
  641.     set alreadyBound 1
  642.     } else {
  643.     set alreadyBound 0
  644.     }
  645.  
  646.     set opt(-balloonmsg) {}
  647.     set opt(-statusmsg)  {}
  648.     set opt(-msg)        {}
  649.  
  650.     tixHandleOptions opt {-balloonmsg -msg -statusmsg} $args
  651.  
  652.     if {$opt(-balloonmsg) != {}} {
  653.     set data(m:$client) $opt(-balloonmsg)
  654.     } else {
  655.     set data(m:$client) $opt(-msg)
  656.     }
  657.     if {$opt(-statusmsg) != {}} {
  658.     set data(s:$client) $opt(-statusmsg)
  659.     } else {
  660.     set data(s:$client) $opt(-msg)
  661.     }
  662.  
  663.     # Set up the bindings of the widget, in which the balloon should appear
  664.     #
  665.     tixBalloon::BindOneWidget $w $client $client
  666. }
  667.  
  668. proc tixBalloon::unbind {w client} {
  669.     upvar #0 $w data
  670.  
  671.     if [info exists data(m:$client)] {
  672.     catch {unset data(m:$client)}
  673.     catch {unset data(s:$client)}
  674.  
  675.     if [winfo exists $client] {
  676.         catch {tixDeleteBindTag $client TixBalloon$client}
  677.     }
  678.     }
  679. }
  680.  
  681.